#load packages
library(devtools)
## Loading required package: usethis
library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(gganimate)
## Loading required package: ggplot2
library(ggforce)
library(ggplot2)
library(readr)

# load helper functions
#install.packages("patchwork")
source_url("https://raw.githubusercontent.com/asonty/ngs_highlights/master/utils/scripts/data_utils.R")
## SHA-1 hash of file is 41d9b285cdbab225cfc5a46dbd15ae742b591dc2
source_url("https://raw.githubusercontent.com/asonty/ngs_highlights/master/utils/scripts/plot_utils.R")
## SHA-1 hash of file is 24e218e6f49b700d341aa13846fcc31d42058193
MIA_plays <- read_csv("nfl-big-data-bowl-2021/team_plays/MIA_plays.csv", 
                      col_types = cols(X1 = col_skip()))
## Warning: Missing column names filled in: 'X1' [1]
## Warning: 77184 parsing failures.
##  row                  col           expected actual                                              file
## 6643 penaltyCodes         1/0/T/F/TRUE/FALSE UNRd   'nfl-big-data-bowl-2021/team_plays/MIA_plays.csv'
## 6643 penaltyJerseyNumbers 1/0/T/F/TRUE/FALSE TEN 21 'nfl-big-data-bowl-2021/team_plays/MIA_plays.csv'
## 6644 penaltyCodes         1/0/T/F/TRUE/FALSE UNRd   'nfl-big-data-bowl-2021/team_plays/MIA_plays.csv'
## 6644 penaltyJerseyNumbers 1/0/T/F/TRUE/FALSE TEN 21 'nfl-big-data-bowl-2021/team_plays/MIA_plays.csv'
## 6645 penaltyCodes         1/0/T/F/TRUE/FALSE UNRd   'nfl-big-data-bowl-2021/team_plays/MIA_plays.csv'
## .... .................... .................. ...... .................................................
## See problems(...) for more details.
head(MIA_plays)
## # A tibble: 6 x 52
##   time                    x     y     s     a   dis     o   dir event  nflId
##   <dttm>              <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <chr>  <dbl>
## 1 2018-09-09 17:13:44  77.8  33.4  0.97  1.13  0.09 131.  278.  None  2.35e3
## 2 2018-09-09 17:13:44  84.5  17.1  0     0     0    295.  241.  None  2.65e3
## 3 2018-09-09 17:13:44  82.3  18.3  0.11  0.38  0.01  60.4  54.1 None  7.14e4
## 4 2018-09-09 17:13:44  84.7  36.6  0     0     0    276.  142.  None  2.51e6
## 5 2018-09-09 17:13:44  88.0  23.7  0.01  0.01  0    269.  305.  None  2.53e6
## 6 2018-09-09 17:13:44  68.2  23.2  0.36  1.02  0.03 107.  191.  None  2.54e6
## # … with 42 more variables: displayName <chr>, jerseyNumber <dbl>,
## #   position <chr>, frameId <dbl>, team <chr>, gameId <dbl>, playId <dbl>,
## #   playDirection <chr>, route <chr>, gameDate <chr>, gameTimeEastern <time>,
## #   homeTeamAbbr <chr>, visitorTeamAbbr <chr>, week <dbl>,
## #   playDescription <chr>, quarter <dbl>, down <dbl>, yardsToGo <dbl>,
## #   possessionTeam <chr>, playType <chr>, yardlineSide <chr>,
## #   yardlineNumber <dbl>, offenseFormation <chr>, personnelO <chr>,
## #   defendersInTheBox <dbl>, numberOfPassRushers <dbl>, personnelD <chr>,
## #   typeDropback <chr>, preSnapVisitorScore <dbl>, preSnapHomeScore <dbl>,
## #   gameClock <time>, absoluteYardlineNumber <dbl>, penaltyCodes <lgl>,
## #   penaltyJerseyNumbers <lgl>, passResult <chr>, offensePlayResult <dbl>,
## #   playResult <dbl>, epa <dbl>, isDefensivePI <lgl>, homeTeamFlag <dbl>,
## #   teamAbbr <chr>, positionGroup <chr>

R Markdown

This is an R Markdown document. Markdown is a simple formatting syntax for authoring HTML, PDF, and MS Word documents. For more details on using R Markdown see http://rmarkdown.rstudio.com.

When you click the Knit button a document will be generated that includes both content as well as the output of any embedded R code chunks within the document. You can embed an R code chunk like this:

# rename column
names(MIA_plays)[names(MIA_plays) == "frameId"] <- "frame"
colnames(MIA_plays)
##  [1] "time"                   "x"                      "y"                     
##  [4] "s"                      "a"                      "dis"                   
##  [7] "o"                      "dir"                    "event"                 
## [10] "nflId"                  "displayName"            "jerseyNumber"          
## [13] "position"               "frame"                  "team"                  
## [16] "gameId"                 "playId"                 "playDirection"         
## [19] "route"                  "gameDate"               "gameTimeEastern"       
## [22] "homeTeamAbbr"           "visitorTeamAbbr"        "week"                  
## [25] "playDescription"        "quarter"                "down"                  
## [28] "yardsToGo"              "possessionTeam"         "playType"              
## [31] "yardlineSide"           "yardlineNumber"         "offenseFormation"      
## [34] "personnelO"             "defendersInTheBox"      "numberOfPassRushers"   
## [37] "personnelD"             "typeDropback"           "preSnapVisitorScore"   
## [40] "preSnapHomeScore"       "gameClock"              "absoluteYardlineNumber"
## [43] "penaltyCodes"           "penaltyJerseyNumbers"   "passResult"            
## [46] "offensePlayResult"      "playResult"             "epa"                   
## [49] "isDefensivePI"          "homeTeamFlag"           "teamAbbr"              
## [52] "positionGroup"

Including Plots

You can also embed plots, for example:

## [1] 11
## [1] 179
### pick a play to visualize
play_data <- filter(MIA_plays, playId == "4172") #BAL 4347 (a lot of laterals)

first_frame <- play_data %>%
  filter(event == "ball_snap") %>% 
  distinct(frame) %>% 
  slice_max(frame) %>% 
  pull()

final_frame <- play_data %>% 
  filter(event == "tackle" | event == "touchdown" | event == "out_of_bounds") %>% 
  distinct(frame) %>% 
  slice_max(frame) %>% 
  pull()

first_frame
## [1] 11
final_frame
## [1] 179
# plot play frame plot
plot_play_frame(play_data_ = play_data, frame_ = 11)

# plot play frame plot with velocity vectors
plot_play_frame(play_data_ = play_data, frame_ = 50, velocities_ = T)

# plot play frame plot with Voronoi Tessellation
#install.packages("deldir")
library(deldir)
## deldir 0.2-3      Nickname: "Stack Smashing Detected"
## 
##      Note 1: As of version 0.2-1, error handling in this 
##      package was amended to conform to the usual R protocol. 
##      The deldir() function now actually throws an error 
##      when one occurs, rather than displaying an error number 
##      and returning a NULL.
##  
##      Note 2:  As of version 0.1-29 the arguments "col" 
##      and "lty" of plot.deldir() had their names changed to 
##      "cmpnt_col" and "cmpnt_lty" respectively basically 
##      to allow "col" and and "lty" to be passed as "..." 
##      arguments.
##  
##      Note 3: As of version 0.1-29 the "plotit" argument 
##      of deldir() was changed to (simply) "plot".
##  
##      See the help for deldir() and plot.deldir().
plot_play_frame(play_data_ = play_data, frame_ = 50, velocities_ = F, voronoi_ = T)

# plot n play frames Voronoi Tessellation (mess around with first frame to get to work)
plot_play_sequence(play_data, first_frame_ = first_frame, final_frame_ = final_frame, n_ = 3, velocities_ = T, voronoi_ = T)

### Animating plays
# reduce dataset
reduced_play_data <- play_data %>% filter(frame >= first_frame, frame <= final_frame+10)

# get play details
play_desc <- reduced_play_data$playDescription %>% .[1]
play_dir <- reduced_play_data$playDirection %>% .[1]
yards_togo <- reduced_play_data$yardsToGo %>% .[1]
los <- reduced_play_data$absoluteYardlineNumber %>% .[1]
togo_line <- if(play_dir=="left") los-yards_togo else los+yards_togo

# separate player and ball tracking data
player_data <- reduced_play_data %>% 
  select(frame, homeTeamFlag, teamAbbr, displayName, nflId, jerseyNumber, position, positionGroup,
         x, y, s, o, dir, event) %>% 
  filter(displayName != "Football")
ball_data <- reduced_play_data %>% 
  select(frame, homeTeamFlag, teamAbbr, displayName, jerseyNumber, position, positionGroup,
         x, y, s, o, dir, event) %>% 
  filter(displayName == "Football")

# get team details
h_team <- reduced_play_data %>% filter(homeTeamFlag == 1) %>% distinct(teamAbbr) %>% pull()
a_team <- reduced_play_data %>% filter(homeTeamFlag == 0) %>% distinct(teamAbbr) %>% pull()

# call helper function to get team colors
team_colors <- fetch_team_colors(h_team_ = h_team, a_team_ = a_team)
h_team_color1 <- team_colors[1]
h_team_color2 <- team_colors[2]
a_team_color1 <- team_colors[3]
a_team_color2 <- team_colors[4]

# compute velocity components
# velocity angle in radians
player_data$dir_rad <- player_data$dir * pi / 180

# velocity components
player_data$v_x <- sin(player_data$dir_rad) * player_data$s
player_data$v_y <- cos(player_data$dir_rad) * player_data$s

# identify the fastest player from each team at each frame
fastest_players <- player_data %>% # filter out ball-tracking data
  group_by(frame, teamAbbr) %>% # group by frame and team
  arrange(s) %>% top_n(s, n=1) %>% # take only the players with the highest speed on each team at every frame
  mutate(isFastestFlag = 1) %>% # create new flag identifying fastest players
  ungroup() %>% 
  select(frame, nflId, isFastestFlag) %>%  # reduce dataset to the columns needed for joining and the new flag
  arrange(frame) # sort by frame

player_data <- player_data %>% 
  left_join(fastest_players, by = c("frame" = "frame", "nflId" = "nflId")) %>% # join on frame and nf;Id
  mutate(isFastestFlag = case_when(is.na(isFastestFlag) ~ 0, TRUE ~ 1)) # replace NA values for isFastestFlag with 0

# this does the same thing
#player_data <- left_join(player_data,fastest_players, by = c("frame" = "frame", "nflId" = "nflId"))
#player_data$isFastestFlag[is.na(player_data$isFastestFlag)] = 0

play_frames <- plot_field() + # plot_field() is a helper function that returns a ggplot2 object of an NFL field
  # line of scrimmage
  annotate(
    "segment",
    x = los, xend = los, y = 0, yend = 160/3,
    colour = "#0d41e1"
  ) +
  # 1st down marker
  annotate(
    "segment",
    x = togo_line, xend = togo_line, y = 0, yend = 160/3,
    colour = "#f9c80e"
  ) +
  # away team velocities
  geom_segment(
    data = player_data %>% filter(teamAbbr == a_team),
    mapping = aes(x = x, y = y, xend = x + v_x, yend = y + v_y),
    colour = a_team_color1, size = 1, arrow = arrow(length = unit(0.01, "npc"))
  ) + 
  # home team velocities
  geom_segment(
    data = player_data %>% filter(teamAbbr == h_team),
    mapping = aes(x = x, y = y, xend = x + v_x, yend = y + v_y),
    colour = h_team_color1, size = 1, arrow = arrow(length = unit(0.01, "npc"))
  ) +
  # away team locations
  geom_point(
    data = player_data %>% filter(teamAbbr == a_team),
    mapping = aes(x = x, y = y),
    fill = "#ffffff", color = a_team_color2,
    shape = 21, alpha = 1, size = 6
  ) +
  # away team jersey numbers
  geom_text(
    data = player_data %>% filter(teamAbbr == a_team),
    mapping = aes(x = x, y = y, label = jerseyNumber),
    color = a_team_color1, size = 3.5, #family = "mono"
  ) +
  # home team locations
  geom_point(
    data = player_data %>% filter(teamAbbr == h_team),
    mapping = aes(x = x, y = y),
    fill = h_team_color1, color = h_team_color2,
    shape = 21, alpha = 1, size = 6
  ) +
  # home team jersey numbers
  geom_text(
    data = player_data %>% filter(teamAbbr == h_team),
    mapping = aes(x = x, y = y, label = jerseyNumber),
    color = h_team_color2, size = 3.5, #family = "mono"
  ) +
  # ball location
  geom_point(
    data = ball_data,
    mapping = aes(x = x, y = y),
    fill = "#935e38", color = "#d9d9d9",
    shape = 21, alpha = 1, size = 4
  ) +
  # highlight fastest players
  geom_point(
    data = player_data %>% filter(isFastestFlag == 1),
    mapping = aes(x = x, y = y),
    colour = "#e9ff70",
    alpha = 0.5, size = 8
  ) +
  # play description and always cite your data source!
  labs(
    title = play_desc, #strwrap(play_desc,100)
    caption = "Source: NFL Next Gen Stats"
  ) + 
  # animation stuff
  transition_time(frame) +
  ease_aes('linear') +
  NULL

# ensure timing of play matches 10 frames-per-second (h/t NFL Football Ops)
play_length <- length(unique(player_data$frame))
play_anim <- animate(
  play_frames,
  fps = 10, 
  nframe = play_length,
  width = 850,
  height = 500,
  end_pause = 10
)

play_anim

## [1] "(:07) (Shotgun) R.Tannehill pass short right to K.Stills to MIA 45 for 14 yards. Lateral to D.Parker to MIA 48 for 3 yards. Lateral to K.Drake for 52 yards, TOUCHDOWN. The Replay Official reviewed the score ruling, and the play was Upheld. The ruling on the field was confirmed."